home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / comm / fido / shelter191a.lha / rexx / Browse.rexx < prev    next >
OS/2 REXX Batch file  |  1994-07-26  |  34KB  |  962 lines
  1. /**/
  2. v="$VER: Browse  Rexx FileList Browser Williamson 55.63"
  3. pview="PPDC"            /* Viewer for PowerPacked files */
  4. tview="PPDC"            /* Viewer for plain text files  */
  5. search="Search NONUM"   /* FileList Search command */
  6. SinceLimit=36           /* Number of days back allowed for NewFiles,NewSince */
  7. TimeLimit=12            /* Number of Browsing minutes allowed */
  8. InputTimeout=45         /* Number of seconds to wait for user input */
  9. MaxTimeouts=4           /* Maximun number of user timeouts permitted */
  10. fileslist='MAIL:FILELISTS/01670104.LST'
  11. freqlist='RAM:FREQ.LST'
  12. config="CFG:Browse.CFG"
  13. NOLIST='~(area.text|files.bbs|LZTEMP.#?|.info)'
  14. LISTFMT='"%-20N%7L %-9D %C"';FLLEN=77;MARGINALL=45 
  15. tmpbbs="T:MLST"Pragma('ID')
  16. tmpnew="T:NLST"Pragma('ID')
  17. tmpsch="T:SLST"Pragma('ID')
  18. newall="T:ALST"Pragma('ID')
  19. matchlist="T:VLST"Pragma('ID')
  20. temp="ram:"
  21. tmplst="TLST"Pragma('ID')
  22. script="File Stack Browser";sv="v"||right(v,5)
  23. lf='0a'x;NL='0d'x||'0a'x;cls='0C'x||'0A'x;quote='"'
  24. stacked=0;cstack="";ucmd="";x=""
  25. NumString=2;OneChar=1;OneWord=0;AddCmd=1;DelCmd=0
  26. direction.0="REVERSE";direction.1="FORWARD"
  27. timeouts=0;timeup=0;notgrab=0
  28. log=show('p','ROOFLOG')
  29. if ~show("L", "rexxsupport.library") then
  30.     if ~addlib("rexxsupport.library", 0, -30, 0) then do
  31.             say "Couldn't access support.library !"
  32.             exit 20
  33.     end
  34. if ~show("L", "RexxDosSupport.library") then
  35.     if ~addlib("RexxDosSupport.library", 0, -30, 0) then do
  36.             say "Couldn't access WB2 support.library !"
  37.             exit 20
  38.     end
  39.  
  40. options results
  41. options failat 20
  42. numeric digits 14
  43. signal on halt
  44. signal on ioerr
  45. signal on break_c
  46. signal on break_d
  47.  
  48. if arg()=0 then do
  49.     debug=1
  50.     ansi=1;expert=1;screen=20;page=40
  51.     username="Beta Tester";bytelimit=1440000
  52.     call open('bd','CON:1000/0/250/250/Browse Debug/AUTO/CLOSE/WAIT','w')
  53. end;else do
  54.     debug=0
  55.     ansi=1;expert=1;screen=20;page=40
  56. /*    ansi=1;expert=0;screen=10;page=20 */
  57.     baseport=GetClip('SHELTER')
  58.     if baseport="ROOF" then envpath="";else envpath=baseport"/"
  59.     auxdev=GetVar(envpath||'AUXDEV',"G")
  60.     auxmount=GetVar(envpath||'AUXMOUNT',"G")
  61.     if ~showlist("H",auxdev) then do
  62.         options failat 99999
  63.         ADDRESS COMMAND auxmount
  64.         options failat 20
  65.     end
  66.     parse arg baud port bytelimit username
  67.     Address VALUE baseport||port
  68.     'String $(device) $(unit) $(locked) $(baudlocked)'
  69.     parse var RESULT device unit locked baudlocked .
  70.     if locked="TRUE" then redirect=GetVar(envpath||'AUXDIRECT',"G")||strip(device)'/'strip(unit)'/con/shared/checkcd/speed'||strip(baudlocked)
  71.     else redirect=GetVar(envpath||'AUXDIRECT',"G")||strip(device)'/'strip(unit)'/con/shared/checkcd/speed'||strip(baud)
  72. end
  73. uname=""
  74. do i=1 to words(username)
  75.     if datatype(word(username,i),'N') then do
  76.         notgrab=1;iterate
  77.     end
  78.     uname=uname||word(username,i)" "
  79. end
  80. username=strip(uname);drop uname
  81. if ~exists(freqlist) | ~exists(fileslist) | ~exists(config) then do
  82.     call Send(' Sorry, 'username' the sysop has not yet configured Browse'NL)
  83.     signal cleanup
  84. end
  85. /* Start Area Processing */
  86. if ~open('dlst',config, 'R') then do
  87.     call send(" SYSTEM ERROR: Couldn't open fileareas list" config||NL)
  88.     signal cleanup
  89. end
  90. CSI='1b'x||'[';AOFF=CSI||'0m';BOLD=CSI||'1m';ITALICS=CSI||'3;40m'
  91. invalid=" Invalid command"NL
  92. nomarks=" There are no files marked for download"NL
  93. call send(cls||ITALICS" "script sv||AOFF||NL||BOLD" by Robert Williamson 1:167/104.0@fidonet"AOFF||NL)
  94.  
  95. /* Start Area Processing */
  96. sincedate=0;markedbytes=0;marks=0;mlist="";blist="";plist="";days=""
  97.  
  98. call send(' Welcome to 'script', 'username||NL)
  99.  
  100. call send(NL' Your current byte limit is 'bytelimit' bytes and your current'NL)
  101. call send('  browsing time limit is 'timelimit' mins.  There is a 'InputTimeout' second'NL)
  102. call send('  timeout when waiting for your command input. Note that Browse will'NL)
  103. call send('  terminate after after 'MaxTimeouts' timeouts.'NL||NL)
  104. call getreturn
  105. call send('  General Help'NL)
  106. call send('  Type c;e;q to turn off Expert mode for more help, Longer menus'NL)
  107. call send('  and shorter listings of areas and files.'NL||NL)
  108. call send('  In all listings, the RETURN key pages in the current [D]irection.'NL)
  109. call send('  Seems a lot of people have problems understanding what a Return Key is..'NL||NL)
  110. call send('  When a prompt shows one of two choices in UPPERCASE, (Y/n) for example,'NL)
  111. call send('  this is the default. The default is executed if you timeout or'NL)
  112. call send('  enter an unexpected character.'NL) 
  113. call send('  Commands may be separated by spaces, commas or semicolons.'NL||NL)
  114. call send('  The Stack is cleared if certain errors occur (Search,NewSInce)'NL)
  115. call send('  Example:  c;e q 23,n 1 m 1,2,3;q d;d'NL)  
  116. call send('  set expert menus, mark and download files 1 2 and 3 from'NL)
  117. call send('  todays newfiles in area 23. If no newfiles, stack is cleared.'NL||NL)
  118. call getreturn
  119.  
  120. call send(' Reading file area configuration.')
  121. area=1
  122. do while ~eof('dlst')
  123.     call send('.')
  124.     ln=strip(readln('dlst'))
  125.     if ln="" then iterate
  126.     parse var ln Number.area '"' Path.area '"' '"' Name.area '"' .
  127.     area=area+1
  128. end /*eof*/
  129. call close('dlst')
  130. areas=area-1
  131. call send(NL' Found 'areas' file areas'NL)
  132. call send(' Browse Timer started'NL);call time('r')
  133. maincmd:
  134. if stacked then x=popstack(OneChar)
  135. else do
  136.     if expert then ucmd=uprompt(NL||BOLD ,
  137.         ||" [A]reas      [S]earch    [N]ewfiles   [E]xit"NL ,
  138.         ||" [D]ownload   [C]hange    [H]elp       Select Area: "AOFF)
  139.     else do
  140.         call help_m('novice')
  141.         ucmd=uprompt(BOLD" Command: "AOFF)
  142.     end
  143.     stacked=pushstack(ucmd,AddCmd)
  144.     if stacked then x=popstack(OneChar);else x=upper(left(ucmd,1))
  145. end    
  146. if x="D" then signal download
  147. else if x="S" then call searchlist(pushstack(ucmd,DelCmd))
  148. else if x="C" then do
  149.     call changeopt(pushstack(ucmd,DelCmd))
  150.     call send(cls)
  151. end;else if x="N" then do
  152.     call newsinceall(pushstack(ucmd,DelCmd))  
  153.     call send(cls)
  154. end;else if x="H" then do
  155.     call help_m()
  156.     call send(cls)
  157. end;else if x="E" then do
  158.     if marks>0 then signal download
  159.     else signal nomarkexit
  160. end;else if datatype(x,"N") then do
  161.     call showarea(x)
  162.     signal maincmd
  163. end;else if x="A" then do
  164.     call listareas(pushstack(ucmd,DelCmd))
  165. end
  166. signal maincmd
  167. call cleanup
  168. exit 0
  169.  
  170. listareas:
  171. call send(cls)
  172.  
  173. if stacked then do
  174.     x=popstack(NumString)
  175.     if datatype(x,"N") & (x>0 & x<areas) then do
  176.         call showarea(x)
  177.         signal maincmd
  178.     end
  179. end
  180.  
  181.  
  182. display=1;scroll=1
  183. do plines=1 to areas
  184.     if Name.plines='NAME.'plines then iterate
  185.     Number.plines=strip(Number.plines)
  186.     if length(Number.plines)=1 then call send("  "Number.plines"    "BOLD||Name.plines||AOFF||NL)
  187.     else call send(" "Number.plines"    "BOLD||Name.plines||AOFF||NL)
  188.     display=display+1
  189.     if display>screen | plines=areas then do
  190.         if stacked then x=popstack(OneChar)
  191.         else do
  192.             if expert then ucmd=uprompt(NL||BOLD ,
  193.                 ||" [N]ewfiles    [S]earch    [C]hange Menu  [Q]uit to Main Menu"NL ,
  194.                 ||" [D]irection   [H]elp      Select Area or Hit Return Key to page "direction.scroll": "AOFF)
  195.             else do
  196.                 call help_l('novice')
  197.                 ucmd=uprompt(NL||BOLD" Hit Return Key to page "direction.scroll"  Command: "AOFF)
  198.             end
  199.             stacked=pushstack(ucmd,AddCmd)
  200.             if stacked then x=popstack(OneChar);else x=upper(left(ucmd,1))
  201.         end
  202.         if datatype(x,"N") & (x>0 & x<areas) then do
  203.             call showarea(x)
  204.             signal maincmd
  205.         end;else if x="S" then call searchlist(pushstack(ucmd,DelCmd))
  206.         else if x="C" then call changeopt(pushstack(ucmd,DelCmd))
  207.         else if x="N" then call newsinceall(pushstack(ucmd,DelCmd))
  208.         else if x="H" then call help_l()
  209.         else if x="D" then scroll=~scroll
  210.         else if x="Q" then signal maincmd
  211.         else if x~="-" & x~="" then call send(invalid)
  212.         call send(cls)
  213.         display=1
  214.         if ~scroll then do
  215.             if plines>page then plines=plines-page;else plines=0
  216.         end
  217.     end
  218. end
  219. signal listareas
  220.     
  221. nomarkexit:
  222. call send(nomarks)
  223. if notgrab then call send(' Returning to system'NL)
  224. else call send(' Returning to GRAB'NL)
  225. call cleanup()
  226. call delay(30)
  227. exit 0
  228.  
  229. changeopt:
  230. call send(cls)
  231. do forever
  232.     if stacked then x=popstack(OneChar)
  233.     else do
  234.         if expert then ucmd=uprompt(NL||BOLD" [A]nsi       [E]xpert    [Q]uit to Main Menu: "AOFF)
  235.         else do
  236.             call help_c('novice')
  237.             ucmd=uprompt(NL||BOLD" Command: "AOFF)
  238.         end
  239.         stacked=pushstack(ucmd,AddCmd)
  240.         if stacked then x=popstack(OneChar);else x=upper(left(ucmd,1))
  241.     end   
  242.     if x="Q" then return
  243.     if x="A" then do
  244.         ansi=~(ansi)
  245.         if ansi then do
  246.             CSI='1b'x||'[';AOFF=CSI||'0m';BOLD=CSI||'1m';ITALICS=CSI||'3;40m'
  247.         end;else do
  248.             CSI='';AOFF='';BOLD='';ITALICS=''
  249.         end
  250.     end
  251.     if x="E" then do
  252.         expert=~(expert)
  253.         if expert then do
  254.             screen=20;page=40
  255.         end;else do
  256.             screen=10;page=20
  257.         end
  258.     end
  259. end
  260. return
  261.  
  262. download:
  263. if timeup then call send(BOLD' Your time is up'AOFF||NL)
  264. if marks=0 then do
  265.     call send(nomarks)
  266.     if timeup then signal nomarkexit
  267.     else signal maincmd
  268. end
  269. call send(' You have selected 'marks' files, 'markedbytes' Bytes'NL)
  270. do i=1 to words(mlist)
  271.     call send(" "right_justify(i,2)" "left_justify(word(mlist,i),24)" "right_justify(word(blist,i)" bytes",24)||NL)
  272. end
  273. bytesleft=bytelimit-markedbytes
  274. if bytesleft>0 then call send(copies(" ",13)||"Bytes Remaining:"||right_justify(bytesleft" bytes",24)||NL)
  275.  
  276. if stacked then x=popstack(OneChar)
  277. else do
  278.     if expert then ucmd=uprompt(NL||BOLD ,
  279.         ||" [D]ownload   [C]ontinue  [U]nmark    [A]bort"NL ,
  280.         ||" [H]elp: "AOFF)
  281.     else do
  282.         call help_d('novice')
  283.         ucmd=uprompt(NL||BOLD" Command: "AOFF)
  284.     end
  285.     stacked=pushstack(ucmd,AddCmd)
  286.     if stacked then x=popstack(OneChar);else x=upper(left(ucmd,1))
  287. end
  288. if ~timeup & x="C" then signal maincmd
  289. else if x="U" then do
  290.     if stacked then unmark=popstack(OneChar);else unmark=word(uprompt(" Select file number to Unmark: "),1)
  291.     if datatype(unmark,"N") & unmark~="" & (unmark < words(mlist)+1) then do
  292.         mlist=space(delstr(mlist,pos(word(mlist,unmark),mlist),length(word(mlist,unmark))+1),1)
  293.         blist=space(delstr(blist,pos(word(blist,unmark),blist),length(word(blist,unmark))+1),1)
  294.         marks=marks-1
  295.         markedbytes=0
  296.         do i=1 to words(blist)
  297.             markedbytes=markedbytes+word(blist,i)
  298.         end
  299.     end
  300.     signal download
  301. end;else if x="H" then do
  302.     call help_d()
  303.     signal download
  304. end;else if x="D" then do
  305.     if marks=0 then do
  306.         call send(nomarks)
  307.         if ~timeup then signal maincmd
  308.     end
  309.     if notgrab then do
  310.         call send(' Select GRAB on the Main Menu to download the files you have marked'NL)
  311.         call delay(50)
  312.     end
  313.     greq='Mail:Inbound/USERS/'translate(upper(strip(username)),'_',' ')||'.GRAB'
  314.     mlist=translate(mlist,'0a'x," ")
  315.     call open('req',greq,"W")
  316.     call writech('req',mlist)
  317.     call close('req')
  318.     call cleanup()
  319.     exit 1
  320. end;else if x="A" then do
  321.     call send(' Clearing marked files list'NL)
  322.     signal nomarkexit
  323. end;else if x~="-" & x~="" then call send(invalid)
  324. signal download
  325. return 0
  326.  
  327. showarea:
  328. area=arg(1)
  329. if Path.area="PATH."area | upper(strip(Path.area))="NULL:" then do
  330.     call ClrStackErr('Area 'BOLD||area||AOFF' does not exist')
  331.     return
  332. end
  333. call send(' Scanning Area:'area BOLD||Name.area||AOFF||NL)
  334. areadir=addslash(dequote(Path.area))
  335. las='PIPE LIST 'areadir||NOLIST' FILES NOHEAD LFORMAT 'LISTFMT' | SORT In: 'tmpbbs
  336. address command las
  337. call send(cls)
  338. call wrapmark(tmpbbs)
  339. return
  340.  
  341.  
  342. searchlist:
  343. call send(cls)
  344. scmd:
  345. if stacked then x=popstack(OneChar)
  346. else do
  347.     if expert then ucmd=uprompt(NL||BOLD" [F]ile       [D]esc      [H]elp      [Q]uit Search: "AOFF)
  348.     else do
  349.         call help_s('novice')
  350.         ucmd=uprompt(NL||BOLD" Command: "AOFF)
  351.     end
  352.     stacked=pushstack(ucmd,AddCmd)
  353.     if stacked then x=popstack(OneChar);else x=upper(left(ucmd,1))
  354. end
  355. if x="Q" then do
  356.     call send(cls)
  357.     return
  358. end
  359. if x="H" then do
  360.     call help_s()
  361.     signal scmd
  362. end
  363. if x="F" then do
  364.     if stacked then tofind=popstack(OneWord);else tofind=uprompt(' Enter AmigaDOS wildcard File search string: ')
  365.     if tofind="" then return
  366.     if pos('*',tofind)>0 then do
  367.         call send(' Please use standard AmigaDos wildcards'NL)
  368.         return
  369.     end
  370.     if pos('#?',tofind)=0 then do
  371.         call send(' AmigaDOs WildCard missing, adding default'||NL)
  372.         tofind=tofind'#?'
  373.     end
  374.     call send(' Searching for Files matching 'tofind||NL)
  375.     address COMMAND 'Fsearch >'matchlist freqlist tofind' -s'
  376.     if ~open('ml',matchlist,'r') then return
  377.     cmd=1;lstring.cmd=""
  378.     call open('x',tmpsch,'w');call close('x')
  379.     do while ~eof('ml')
  380.         fl=readln('ml')
  381.         if fl="!@ No match found" then do
  382.             call ClrStackErr(fl" for file:"tofind)
  383.             call close('ml')
  384.             return
  385.         end
  386.         fn=word(fl,2)
  387.         las='LIST 'lstring.cmd' NOHEAD LFORMAT 'LISTFMT' >>'tmpsch
  388.         if length(fn)+length(las)+1 >200 then do
  389.             cmd=cmd+1
  390.             lstring.cmd=""
  391.         end
  392.         lstring.cmd=lstring.cmd' 'fn
  393.     end
  394.     call close('ml')
  395.     do i=1 to cmd
  396.         las='LIST 'lstring.i' NOHEAD LFORMAT 'LISTFMT' >>'tmpsch
  397.         options failat 99;address command las;options failat 20
  398.         call delay(50)
  399.     end
  400.     call wrapmark(tmpsch)
  401. end;else if x="D" then do
  402.     if stacked then tofind=popstack(OneWord);else tofind=word(uprompt(' Enter a keyword for Description search: '),1)
  403.     if tofind="" then return
  404.     call send(' Searching for Descriptions containing keyword:'tofind||NL)
  405.     address COMMAND search' >'matchlist fileslist tofind
  406.     if ~open('ml',matchlist,'r') then do
  407.         call ClrStackErr('!@ No match found for keyword:'tofind)
  408.         return
  409.     end
  410.     if ~open('x',tmpsch,'w') then return
  411.     discard=readln('ml')
  412.     do while ~eof('ml')
  413.         call writeln('x',delstr(readln('ml'),1,1))
  414.     end
  415.     call close('x');call close('ml')
  416.     call wrapmark(tmpsch)
  417. end;else if x~="-" & x~="" then call send(invalid)
  418. return
  419.  
  420.  
  421. wrapmark:
  422. thelist=arg(1)
  423. if show('F','ifn') then call close('ifn') 
  424. if ~open('ifn',thelist,'R') then do
  425.     call ClrStackErr('SYSTEM Cannot open 'thelist' INFORM SYSOP')
  426.     return 0
  427. end
  428. if thelist=tmpsch then do
  429.     ltype='Search Match'
  430.     atitle=" "ltype" List"
  431. end;else if thelist=newall then do
  432.     ltype='Global NewFiles'
  433.     atitle=" "ltype" List"
  434. end;else if thelist=tmpnew then do
  435.     ltype='NewFiles Area'
  436.     atitle=" "ltype":"area Name.area
  437. end;else do
  438.     ltype='File Area'
  439.     atitle=" "ltype":"area Name.area
  440. end
  441. tagged=0;tag=1;display=1
  442. this_page_offset=0;last_page_offset=0
  443. file_offset=0
  444. this_page_tags=0;last_page_tags=0
  445. scroll=1
  446. if ~areacmd() then do
  447.     call close('ifn')
  448.     return 0
  449. end
  450. call send(cls)
  451. do while ~eof('ifn')
  452.     line=readln('ifn')
  453.     this_page_offset=this_page_offset+(length(line)+1)
  454.     file_offset=file_offset+this_page_offset
  455.     if left(line,1)=":" then iterate
  456.     if left(line,1)=" " then do
  457.         call send(line||NL)
  458.         display=display+1
  459.     end;else do
  460.         file.tag=word(line,1)
  461.         bytes.tag=word(line,2)
  462.         call send(' 'wrap_line('['center(tag,3)']' line,FLLEN,MARGINALL))
  463.         tagged=tag
  464.         tag=tag+1
  465.         this_page_tags=this_page_tags+1
  466.  
  467.         if display>=screen then do
  468.             if debug then do
  469.                 call Kprint('Tag      :'tag' Tagged   :'tagged)
  470.                 call Kprint('Page_Tags:'this_page_tags last_page_tags)
  471.                 call Kprint('FilePos  :'File_offset)
  472.                 call Kprint('Offset   :'this_page_offset last_page_offset)      
  473.             end
  474.  
  475.             if ~areacmd() then do
  476.                 call close('ifn')
  477.                 return 0
  478.             end
  479.  
  480.             if ~scroll then do
  481.                 seek_offset=this_page_offset+last_page_offset
  482.                 file_offset=file_offset-seek_offset
  483.                 tag=tag-(this_page_tags+last_page_tags)
  484.                 tagged=tagged-(this_page_tags+last_page_tags)
  485.                 if file_offset<0 | tag<0 | tagged<0 then do
  486.                     tagged=0;tag=1;display=1
  487.                     this_page_offset=0;last_page_offset=0;file_offset=0
  488.                     this_page_tags=0;last_page_tags=0
  489.                     call seek('ifn',0,'B')
  490.                 end;else do
  491.                     call seek('ifn',-seek_offset,'C')
  492.                     if debug then do
  493.                         call Kprint('Tag      :'tag' Tagged   :'tagged)
  494.                         call Kprint('Page_Tags:'this_page_tags last_page_tags)
  495.                         call Kprint('FilePos  :'File_offset)
  496.                         call Kprint('Offset   :'this_page_offset'+'last_page_offset':'seek_offset)      
  497.                     end
  498.                 end
  499.             end
  500.             display=1
  501.             last_page_offset=this_page_offset
  502.             last_page_tags=this_page_tags
  503.             this_page_offset=0;this_page_tags=0
  504.                 if debug then do
  505.                     call Kprint('Page_Tags:'this_page_tags last_page_tags)
  506.                     call Kprint('Offset   :'this_page_offset last_page_offset)      
  507.                 end
  508.             call send(cls)
  509.         end
  510.     end
  511. end /*eof */
  512. call close('ifn')
  513. call send(' End of 'ltype' Listing'NL)
  514. if areacmd('end') then call wrapmark(thelist)
  515. return
  516.  
  517. areacmd:
  518. if thelist=tmpsch | thelist=newall then do
  519.     notarea=1
  520.     aprompt=ITALICS||atitle||AOFF||NL||BOLD ,
  521.           ||" [M]ark Files  [D]irection   [A]rea Menu   [Q]uit to Main Menu"NL ,
  522.           ||" [H]elp        Hit Return Key to page "direction.scroll": "AOFF
  523. end;else do
  524.     notarea=0
  525.     aprompt=ITALICS||atitle||AOFF||NL||BOLD ,
  526.           ||" [M]ark Files  [D]irection   [A]rea Menu   [Q]uit to Main Menuu"NL ,
  527.           ||" [N]ew Since   [V]iew        [H]elp        Hit Return Key to page "direction.scroll": "AOFF
  528. end    
  529. do forever
  530.     if stacked then x=popstack(OneChar)
  531.     else do
  532.         if expert then ucmd=uprompt(aprompt)
  533.         else do
  534.             call send(atitle||NL)
  535.             call help_a('novice')
  536.             ucmd=uprompt(NL||BOLD" Hit Return Key to page "direction.scroll"  Command: "AOFF)
  537.         end
  538.         stacked=pushstack(ucmd,AddCmd)
  539.         if stacked then x=popstack(OneChar);else x=upper(left(ucmd,1))
  540.     end
  541.     if x="Q" | x="A" then return 0
  542.     else if x="D" then do
  543.         scroll=~scroll
  544.         return 1
  545.     end;else if x="H" then call help_a()
  546.     else if x="N" & ~notarea then call newsince(pushstack(ucmd,AddCmd))
  547.     else if x="M" then do
  548.         if stacked then marked=popstack(NumString);else marked=uprompt(' Files:'marks 'Bytes:'markedbytes' Enter File number(s): ')
  549.         ucmd=""
  550.         do x=1 to words(marked)
  551.             y=word(marked,x)
  552.             if y<1 | y>tagged | ~datatype(y,"N") then do
  553.                 call send(' Invalid mark 'y' ignored, try [H]elp'NL)
  554.                 iterate
  555.             end;else if bytes.y+markedbytes>bytelimit then do
  556.                 call Send(' Sorry, 'file.y bytes.y' bytes exceeds your 'bytelimit' byte limit'NL)
  557.                 iterate
  558.             end;else do
  559.                 markedbytes=markedbytes+bytes.y
  560.                 blist=blist||bytes.y" "
  561.                 mlist=mlist||file.y||" "
  562.                 marks=marks+1
  563.                 call send(' 'file.y bytes.y' bytes,  Marked for Download'NL)
  564.             end
  565.         end
  566.         call getreturn
  567.     end;else if x="V" & ~notarea then do
  568.         if stacked then marked=PopStack(NumString);else marked=uprompt(' Enter number of file to view or list: ')
  569.         y=word(marked,1)
  570.         if y<1 | y>tagged | ~datatype(y,"N") then do
  571.             call send(' Invalid mark 'y' ignored, try [H]elp'NL)
  572.         end;else call viewfile(areadir||file.y)
  573.         call getreturn
  574.     end;else if x="" & arg(1)='end' then do
  575.         scroll=~scroll
  576.         call pushstack('D')   
  577.         return 1  
  578.     end;else if x~="-" & x~="" then call send(invalid)
  579.     else return 1
  580. end
  581. return 0
  582.  
  583.  
  584. wrap_line:
  585. if debug then term=lf;else term=nl
  586. text=arg(1);rEdge=arg(2)/*line length*/;lEdge=arg(3)/*wrapmargin*/
  587. newtext=''
  588. do while length(text)>0
  589.     broken_word=0
  590.     if length(text)<rEdge then do
  591.         newtext=newtext||text||term
  592.         display=display+1;text=''
  593.     end;else do
  594.         tmptext=strip(text,l)
  595.         diff=length(text)-length(tmptext)
  596.         first_break=lastpos(' ',tmptext,rEdge-diff)
  597.         break_point=first_break+diff
  598.         if lEdge=break_point then do
  599.             break_point=rEdge-1
  600.             broken_word=1
  601.         end
  602.         newtext=newtext||strip(left(text,break_point),t)
  603.         if broken_word then newtext=newtext||'-'
  604.         newtext=newtext||term
  605.         display=display+1
  606.         text=copies(' ',lEdge)||strip(right(text,length(text)-break_point),l)
  607.     end
  608. end
  609. return newtext
  610.  
  611. getsince:
  612. if stacked then days=popstack(OneChar);else days=uprompt(' How many days back? (1-'SinceLimit'): ')
  613. if ~datatype(days,"N") | (days<=0 | days>SinceLimit) then do
  614.     call ClrStackErr("Days "days" must be > 0 and < "SinceLimit)
  615.     return 0
  616. end
  617. sincedate=space(date('n',date('i')-days),1,'-')
  618. sincedate=left(overlay(substr(sincedate,10,2),sincedate,8,2),9)
  619. return 1
  620.  
  621. newsinceall:
  622. if sincedate~=0 & exists(newall) then do
  623.     ucmd=upper(uprompt(' View last 'days' days NewFiles list from 'sincedate'? (y/N): '))
  624.     if ucmd="Y" then do
  625.         call wrapmark(newall)
  626.         return
  627.     end
  628. end
  629. if ~getsince() then return
  630. if stacked then dosort=popstack(OneChar)=="S";else dosort=upper(left(uprompt(" Alphabetically [S]orted (fast) or by [A]rea (slow): (s/A) "),1))=="S"
  631. call Send(' Searching 'BOLD'ALL'AOFF' areas for new files received since 'BOLD||sincedate||AOFF||NL)
  632. tmp="";tl=length(BOLD||AOFF)
  633. savelist=(days=7 & ~dosort)
  634. do area=1 to areas
  635.     if Path.area="PATH."area | upper(strip(Path.area))="NULL:" then iterate
  636.     if tmp~="" then do
  637.         if tl>0 then call send(copies('08'x,length(tmp)-tl))
  638.         else call send(copies('08'x,length(tmp)))
  639.     end
  640.     tmp=' Searching Area 'BOLD||Number.area||AOFF
  641.     if ~dosort then Address COMMAND 'Echo >>'newall' "       Area 'BOLD||Number.area' 'ITALICS||Name.area||AOFF'"'
  642.     call send(tmp)
  643.     areadir=addslash(dequote(Path.area))
  644.     las='LIST 'areadir||NOLIST' SINCE' sincedate 'FILES NOHEAD LFORMAT 'LISTFMT' >>'newall
  645.     address COMMAND las
  646. end
  647. call send(NL)
  648. if dosort then address COMMAND "SORT FROM "newall" TO "newall
  649. if savelist then do
  650.     address COMMAND 'COPY 'newall' TO MAIL:FILELISTS/NEWFILES.LST'
  651.     call Send(' Updated Last 7 days NewFiles listing'||NL)
  652. end
  653. call wrapmark(newall)
  654. return
  655.  
  656. newsince:
  657. if ~getsince() then return 0
  658. areadir=addslash(dequote(Path.area))
  659. call Send(' Searching Area 'BOLD||Number.area||AOFF' for new files received since 'BOLD||sincedate||AOFF||NL)
  660. las='PIPE LIST 'areadir||NOLIST' SINCE' sincedate 'FILES NOHEAD LFORMAT 'LISTFMT' | SORT In: 'tmpnew
  661. address COMMAND las
  662. if word(statef(tmpnew),2)>0 then call wrapmark(tmpnew)
  663. else call ClrStackErr('None found')
  664. return
  665.  
  666.  
  667. viewfile:
  668. fname=arg(1)
  669. file=get_fn(fname)
  670. if ~open('in',fname,'R') then do
  671.     call send(" Can't open" '"'file'"'NL)
  672.     call vcleanup
  673.     return
  674. end;else do
  675.     buff=readch('in',8);call close('in')
  676.     select
  677.         when left(buff,4)=='ZOO ' then do
  678.             xcmd='zoo x'
  679.             lcmd='zoo >'tmplst' l'
  680.         end
  681.         when substr(buff,3,3)=='-lh' then do
  682.             xcmd='lha x'
  683.             lcmd='lha >'tmplst' vv'
  684.         end
  685.         when left(buff,1)=='1A'x then do
  686.             xcmd='arc x'
  687.             lcmd='arc >'tmplst' l'
  688.         end
  689.         otherwise cmd=tview
  690.     end
  691.     if cmd=tview then do
  692.         if ~displayable(fname) then call send(' File 'fname' does not seems to be displayable'NL)
  693.         else do
  694.            if debug then address COMMAND cmd fname
  695.            else address COMMAND cmd fname redirect
  696.         end
  697.     end;else do
  698.         call pragma('D',temp)
  699.         call send(" Please wait..listing archive"NL)
  700.         address command lcmd fname
  701.         call send(cls)
  702.         if debug then address COMMAND tview tmplst    
  703.         else address COMMAND tview tmplst redirect
  704.  
  705.         tname=uprompt(" Enter fullpath of file to read: ")
  706.         if tname~="" then do
  707.             call send(NL" Please wait, extracting "tname||NL)
  708.             address command xcmd fname tname
  709.             address COMMAND 'Protect >NIL: 'temp||tname' +d'
  710.             call send(cls)
  711.             cmd=tview
  712.             if ~displayable(temp||tname) then call send(' File 'tname' does not seems to be displayable'NL)
  713.             else do
  714.                if debug then address COMMAND cmd temp||tname
  715.                else address COMMAND cmd temp||tname redirect
  716.             end
  717.         end
  718.         call vcleanup
  719.     end
  720. end
  721. return
  722.  
  723. displayable:
  724. if open('af',arg(1)) then do
  725.     h=readch('af',100)
  726.     call close('af')
  727.     if left(h,2)='PP' then do
  728.         cmd=pview
  729.         return 1
  730.     end;else if length(compress(h,xrange(' ','~')xrange('a0'x,'ff'x)'0a'x))<10 then return 1
  731. end
  732. return 0
  733.  
  734. cleanup:
  735. call vcleanup()
  736. call delete(matchlist)
  737. call delete(tmpbbs)
  738. call delete(tmpsch)
  739. call delete(tmpnew)
  740. call delete(newall)
  741. return
  742. vcleanup:
  743. if exists(temp||tmplst) then call delete(temp||tmplst)
  744. if exists(temp||tname) then call delete(temp||tname)
  745. call pragma('D',olddir)
  746. return
  747.  
  748.  
  749. ClrStackErr:
  750. call send(BOLD" Error:"AOFF||arg(1)" - Clearing command stack"||NL)
  751. stacked=0;cstack=""
  752. call getreturn
  753. return
  754.  
  755. help_m:
  756. if arg(1)~='novice' then call send(cls||BOLD||ITALICS' Main Menu Help'AOFF||NL)
  757. else call send(NL)    
  758. call send(BOLD' Select Area Number 'AOFF' - 'ITALICS'Enter number to Select a file area'AOFF||NL)
  759. call send(BOLD' [A]reas            'AOFF' - 'ITALICS'List available file areas'AOFF||NL)
  760. call send('                       'ITALICS'You can page forwards and backwards'AOFF||NL)
  761. call send(BOLD' [S]earch           'AOFF' - 'ITALICS'Search for a file by name or description'AOFF||NL)
  762. call send(BOLD' [N]ewFiles         'AOFF' - 'ITALICS'List all files received in last N days'AOFF||NL)
  763. call send(BOLD' [D]ownload         'AOFF' - 'ITALICS'List/DownLoad/Clear marked files'AOFF||NL)
  764. call send(BOLD' [C]hange           'AOFF' - 'ITALICS'Change your ANSI, MENU, HELP Settings'AOFF||NL)
  765. call send(BOLD' [E]xit             'AOFF' - 'ITALICS'If you have marked files, you will be'AOFF||NL)
  766. call send('                       'ITALICS'prompted to DownLoad or Abort'AOFF||NL)
  767. call send('                       'ITALICS'otherwise, returns to GRAB'AOFF||NL)
  768. if arg(1)~='novice' then call getreturn
  769. return
  770. help_l:
  771. if arg(1)~='novice' then call send(cls||BOLD||ITALICS' Area Menu Help'AOFF||NL)
  772. else call send(NL)    
  773. call send(BOLD' Select Area Number 'AOFF' - 'ITALICS'Enter number to select a file area'AOFF||NL)
  774. call send(BOLD' [D]irection        'AOFF' - 'ITALICS'Changes direction of areas list paging'AOFF||NL)
  775. call send('                       'ITALICS'RETURN pages in direction selected'AOFF||NL)
  776. call send(BOLD' [N]ewFiles         'AOFF' - 'ITALICS'List all files received in last N days'AOFF||NL)
  777. call send(BOLD' [S]earch           'AOFF' - 'ITALICS'Search for a file by name or description'AOFF||NL)
  778. call send(BOLD' [C]hange           'AOFF' - 'ITALICS'Change ANSI, MENU, EXPERT Settings'AOFF||NL)
  779. call send(BOLD' [Q]uit             'AOFF' - 'ITALICS'Return to Main Menu'AOFF||NL)
  780. if arg(1)~='novice' then call getreturn
  781. return
  782. help_a:
  783. if arg(1)~='novice' then call send(cls||BOLD||ITALICS' File Menu Help'AOFF||NL)
  784. call send(BOLD' [A]rea             'AOFF' - 'ITALICS'Go to Area List Menu'AOFF||NL)
  785. call send(BOLD' [D]irection        'AOFF' - 'ITALICS'Changes direction of files list paging'AOFF||NL)
  786. call send('                       'ITALICS'RETURN pages in direction selected'AOFF||NL)
  787. call send(BOLD' [R]edisplay        'AOFF' - 'ITALICS'Show file list again if at End'AOFF||NL)
  788. call send(BOLD' [N]ew Since        'AOFF' - 'ITALICS'List files in this area received in last N days'AOFF||NL)
  789. call send(BOLD' [M]ark             'AOFF' - 'ITALICS'Mark file(s) for download'AOFF||NL)
  790. call send('                       'ITALICS'Displays number of files and bytes marked'AOFF||NL) 
  791. call send(BOLD' [V]iew             'AOFF' - 'ITALICS'View a text file, the contents of an archive'AOFF||NL)
  792. call send('                       'ITALICS'or a text file in an archive'AOFF||NL)
  793. call send('                       'ITALICS'View is only valid in a FILE area'AOFF||NL)
  794. call send(BOLD' [Q]uit             'AOFF' - 'ITALICS'Return to previous menu'AOFF||NL)
  795. if arg(1)~='novice' then call getreturn
  796. return
  797. help_d:
  798. if arg(1)~='novice' then call send(cls||BOLD||ITALICS' DownLoad Menu Help'AOFF||NL)
  799. else call send(NL)    
  800. call send(BOLD' [C]ontinue         'AOFF' - 'ITALICS'Continue marking files'AOFF||NL)
  801. call send(BOLD' [U]nmark           'AOFF' - 'ITALICS'Unmark and removed file from download list'AOFF||NL)
  802. call send(BOLD' [D]ownload         'AOFF' - 'ITALICS'Gives list of files marked to GRAB'AOFF||NL)
  803. call send('                       'ITALICS'for downloading to you'AOFF||NL)
  804. call send(BOLD' [A]bort            'AOFF' - 'ITALICS'Marked list is cleared and you are'AOFF||NL)
  805. call send('                       'ITALICS'returned to GRAB filename request prompt'AOFF||NL)
  806. if arg(1)~='novice' then call getreturn
  807. return
  808. help_c:
  809. if arg(1)~='novice' then call send(cls||BOLD||ITALICS' Change Menu Help'AOFF||NL)
  810. else call send(NL)    
  811. call send(BOLD' [A]nsi             'AOFF' - 'ITALICS'Toggle ANSI Display'AOFF||NL)
  812. call send(BOLD' [E]xpert           'AOFF' - 'ITALICS'Toggle Expert/Novice Menus'AOFF||NL)
  813. call send(BOLD' [Q]uit             'AOFF' - 'ITALICS'Return to Main menu'AOFF||NL)
  814. if arg(1)~='novice' then call getreturn
  815. return
  816. help_s:
  817. if arg(1)~='novice' then call send(cls||BOLD||ITALICS' Search Menu Help'AOFF||NL)
  818. else call send(NL)    
  819. call send(BOLD' [F]ile             'AOFF' - 'ITALICS'Search for a file by name, USE WILDCARDS'AOFF||NL)
  820. call send('                       'ITALICS'You may mark files for download from match list'AOFF||NL)
  821. call send(BOLD' [D]escription      'AOFF' - 'ITALICS'Search for a file by description, no WILDCARDS'AOFF||NL)
  822. call send('                       'ITALICS'You CAN use a partial description'AOFF||NL)
  823. call send('                       'ITALICS'You may mark files for download from match list'AOFF||NL)
  824. call send(BOLD' [Q}uit             'AOFF' - 'ITALICS'Return to area menu'AOFF||NL)
  825. if arg(1)~='novice' then call getreturn
  826. return
  827.  
  828. getreturn: return uprompt(BOLD' Hit RETURN 'AOFF)
  829.  
  830. pushstack: 
  831. if arg(1)="UCMD" | arg(1)="" then return stacked
  832. if cstack~="" then do
  833.     if arg(2)=DelCmd then cstack=strip(delstr(arg(1),1,length(word(arg(1),1))))
  834.     else cstack=cstack||" "||arg(1)
  835. end;else do
  836.     if arg(2)=DelCmd then cstack=strip(delstr(arg(1),1,length(word(arg(1),1))))
  837.     else cstack=arg(1)
  838. end
  839. stacked=words(cstack)>0
  840. ucmd=""
  841. return stacked
  842.  
  843. popstack:
  844. if cstack="" then do
  845.     stacked=0
  846.     return '-'
  847. end
  848. if arg(1)=NumString then do
  849.     py=""
  850.     do forever
  851.         if cstack="" then return strip(py)
  852.         px=word(cstack,1)
  853.         if ~datatype(px,'N') then return strip(py)
  854.         py=py||" "||strip(px)
  855.         if words(cstack)>1 then cstack=strip(delstr(cstack,1,length(px)))
  856.         else do
  857.             stacked=1;cstack=""
  858.         end
  859.     end
  860. end
  861.  
  862. px=word(cstack,1)
  863. if words(cstack)>1 then cstack=strip(delstr(cstack,1,length(px)))
  864. else do
  865.     stacked=0;cstack=""
  866. end    
  867. if arg(1)=OneChar then do
  868.     if datatype(px,'N') then py=px
  869.     else py=upper(left(px,1))
  870. end
  871. else py=px
  872. return strip(py)
  873.  
  874. Kprint: return writeln('bd',arg(1))
  875.  
  876. send:
  877. if debug then call writech(STDOUT,arg(1))
  878. else do
  879.     'Print' quote||arg(1)||quote
  880.     'Send' quote||arg(1)||quote
  881. end
  882. return
  883.  
  884. uprompt:
  885. if ~timeup then do
  886.     elapsed=time('e')
  887.     remaining=TimeLimit-(elapsed/60)
  888.     if elapsed>=(TimeLimit*60)-120 then call send(BOLD||NL' You have 'trunc(remaining)' Minutes remaining'AOFF||NL) 
  889.     if elapsed>=(TimeLimit*60) then do
  890.         timeup=1    
  891.         call send(BOLD||NL' Poof! Your time is up!'AOFF||NL)
  892.         if marks>0 then signal download
  893.         else signal nomarkexit
  894.     end
  895. end   
  896. if debug then do
  897.     options prompt arg(1)
  898.     parse pull u
  899.     return translate(u,"  ",",;")
  900. end;else do
  901.     'Print' quote||arg(1)||quote
  902.     'Send' quote||arg(1)||quote
  903.     'GetInbound E0 'InputTimeout
  904.     'String $(event)'
  905.     if upper(RESULT)='CARRIER' then do
  906.         call cleanup
  907.         exit 10
  908.     end;else if upper(RESULT)='TIMEOUT' then do
  909.         call send(NL' User Input TIMEOUT:'timeouts||NL)
  910.         timeouts=timeouts+1
  911.         if timeouts>MaxTimeouts then do
  912.             call send(' Sorry, you have made too many input timeouts, bye')
  913.             call cleanup
  914.             exit 10
  915.         end
  916.     end;else if upper(RESULT)='LOGIN' then do
  917.         'String $(namebuf)'
  918.         u=translate(RESULT,"  ",",;")
  919.     end;else u=""
  920. end
  921. return u
  922.  
  923.  
  924. left_justify:
  925. if length(arg(1))>arg(2) then return (left(arg(1),arg(2)))
  926. else return (arg(1)||copies(" ",arg(2)-length(arg(1))))
  927.  
  928. right_justify:
  929. if length(arg(1))>arg(2) then return (right(arg(1),arg(2)))
  930. else return (copies(" ",arg(2)-length(arg(1)))||arg(1))
  931.  
  932. get_fn:
  933. if LastPos('/',arg(1))~=0 then return SubStr(arg(1),LastPos('/',arg(1))+1)
  934. else if LastPos(':',arg(1))~=0 then return SubStr(arg(1),LastPos(':',arg(1))+1)
  935. else return arg(1)
  936.  
  937. addslash:
  938. curr=arg(1)
  939. select
  940. when right(curr, 1)=":" then nop
  941. when right(curr, 1)="/" then nop
  942. otherwise curr=curr"/"
  943. end
  944. return curr
  945.  
  946. dequote:
  947. parse arg thing
  948. parse var thing '"' unq_thing '"'
  949. if unq_thing ~= "" then return unq_thing
  950. return thing
  951.  
  952. break_c:
  953.     if upper(uprompt(NL||' Are you sure you want to Exit? '))=="N" then return
  954. break_d:
  955. halt:
  956. ioerr:
  957. call cleanup()
  958. exit 10
  959. /**/
  960.  
  961.  
  962.